home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / dlasq4.f < prev    next >
Text File  |  1996-07-19  |  3KB  |  104 lines
  1.       SUBROUTINE DLASQ4( N, Q, E, TAU, SUP )
  2. *
  3. *  -- LAPACK routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     September 30, 1994
  7. *
  8. *     .. Scalar Arguments ..
  9.       INTEGER            N
  10.       DOUBLE PRECISION   SUP, TAU
  11. *     ..
  12. *     .. Array Arguments ..
  13.       DOUBLE PRECISION   E( * ), Q( * )
  14. *     ..
  15. *
  16. *     Purpose
  17. *     =======
  18. *
  19. *     DLASQ4 estimates TAU, the smallest eigenvalue of a matrix. This
  20. *     routine improves the input value of SUP which is an upper bound
  21. *     for the smallest eigenvalue for this matrix .
  22. *
  23. *     Arguments
  24. *     =========
  25. *
  26. *  N       (input) INTEGER
  27. *          On entry, N specifies the number of rows and columns
  28. *          in the matrix. N must be at least 0.
  29. *
  30. *  Q       (input) DOUBLE PRECISION array, dimension (N)
  31. *          Q array
  32. *
  33. *  E       (input) DOUBLE PRECISION array, dimension (N)
  34. *          E array
  35. *
  36. *  TAU     (output) DOUBLE PRECISION
  37. *          Estimate of the shift
  38. *
  39. *  SUP     (input/output) DOUBLE PRECISION
  40. *          Upper bound for the smallest singular value
  41. *
  42. *  =====================================================================
  43. *
  44. *     .. Parameters ..
  45.       DOUBLE PRECISION   ZERO
  46.       PARAMETER          ( ZERO = 0.0D+0 )
  47.       DOUBLE PRECISION   BIS, BIS1
  48.       PARAMETER          ( BIS = 0.9999D+0, BIS1 = 0.7D+0 )
  49.       INTEGER            IFLMAX
  50.       PARAMETER          ( IFLMAX = 5 )
  51. *     ..
  52. *     .. Local Scalars ..
  53.       INTEGER            I, IFL
  54.       DOUBLE PRECISION   D, DM, XINF
  55. *     ..
  56. *     .. Intrinsic Functions ..
  57.       INTRINSIC          MAX, MIN
  58. *     ..
  59. *     .. Executable Statements ..
  60.       IFL = 1
  61.       SUP = MIN( SUP, Q( 1 ), Q( 2 ), Q( 3 ), Q( N ), Q( N-1 ),
  62.      $      Q( N-2 ) )
  63.       TAU = SUP*BIS
  64.       XINF = ZERO
  65.    10 CONTINUE
  66.       IF( IFL.EQ.IFLMAX ) THEN
  67.          TAU = XINF
  68.          RETURN
  69.       END IF
  70.       D = Q( 1 ) - TAU
  71.       DM = D
  72.       DO 20 I = 1, N - 2
  73.          D = ( D / ( D+E( I ) ) )*Q( I+1 ) - TAU
  74.          IF( DM.GT.D )
  75.      $      DM = D
  76.          IF( D.LT.ZERO ) THEN
  77.             SUP = TAU
  78.             TAU = MAX( SUP*BIS1**IFL, D+TAU )
  79.             IFL = IFL + 1
  80.             GO TO 10
  81.          END IF
  82.    20 CONTINUE
  83.       D = ( D / ( D+E( N-1 ) ) )*Q( N ) - TAU
  84.       IF( DM.GT.D )
  85.      $   DM = D
  86.       IF( D.LT.ZERO ) THEN
  87.          SUP = TAU
  88.          XINF = MAX( XINF, D+TAU )
  89.          IF( SUP*BIS1**IFL.LE.XINF ) THEN
  90.             TAU = XINF
  91.          ELSE
  92.             TAU = SUP*BIS1**IFL
  93.             IFL = IFL + 1
  94.             GO TO 10
  95.          END IF
  96.       ELSE
  97.          SUP = MIN( SUP, DM+TAU )
  98.       END IF
  99.       RETURN
  100. *
  101. *     End of DLASQ4
  102. *
  103.       END
  104.